00100	C  WORDS,  NAMEXT, TYPOUT
00200		
00300		SUBROUTINE WORDS
00400		INTEGER PWDS
00500		COMMON R2,JA,RC,J2,R3,R4,R5,R6,R7,X,IA,N
00600		1,Z,J,KN,ISET,KNT,Q(26),JR /PTR/PWDS(1)
00700		1 /LIMIT/LIMIT,ITEM,LL,IS,IX
00800	C  /SCX/ IS ALSO IN SCMSS, NOTBMS, RHYTH, BEAMS, NEWR(IN LOOP.FAI), SCAN.FAI
00900	C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
01000	C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
01100		COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
01200		1 ISEMI,IDBQT,IBLA,IDOL,IPRCNT,IANPR,IAT,INUM,LESS,IGT,IAPOS,
01300		1 IQUES,IEXCLA,LBRK,RBRK,UPAR,DNAR,DBLAR,SLA,XX,ZZ,
01400		1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(72),ML
01500		COMMON/SCN/KEL,KR,KU,KD,KSLA,NONO(30)
01600	CC	COMMON/SCN/LEL,LR,LU,LD,KSLA,LE,LC,LS,LF,LA,LI,LW
01700		DIMENSION IAZ(26),JALPHA(30)
01800		COMMON/A2Z/LA,LB,LC,LD,LE,LF,LG,LH,LI,LJ,LK,LEL,LM,
01900		1 LN,LO,LP,LQ,LR,LS,LT,LU,LV,LW,LX,LY,LZ
02000		EQUIVALENCE (ICOM,JALPHA),(INP2,INP(2)),(IAZ,LA),(LSQ,JALPHA(23))
02100		DATA LEL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/,KSLA/'/'/
02200		1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/,XFONT/50./
02300		DATA IAZ/'A','B','C','D','E','F','G','H','I','J','K','L','M',
02400		1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/,
02500		1 IBKSL/"561004020100/
02600	C  IBKSL=\   BACKSLASH - NOT USED YET  5/80
02700		DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
02800		1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
02900		1 ,"555004020100,"565004020100,"571004020100,"5004020100,
03000		1 "135004020100,'/',"755004020100,"771004020100/
03100	C 1ST 2 BIG NUMS ARE [, ], ↑, ↓, ↔, ... {, }
03200	C                  1/4 1/2 #  b nat.   --- 1/8
03300	C   FOR ENTERING TEXT: T, POS., STF., NT#., SIZE
03400		KNT=-1
03500	C COUNTER FOR SEPARATE TEXT ITEMS.
03600	431	FORMAT(72A1)
03700	131	CALL TYPE
03800	531	DO 31 KN=72,1,-1
03900	31	IF(INP(KN).NE.IBLA)GO TO 33
04000	C  KN=NUM OF CHARACTERS
04100	C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
04200	C  , - . = ( ) + * : ; " BLANK (FONTS) ' --THIS IS ORDER PAST ALPHAB.
04300	C ?[=1/8 NOTE, [=QTR NOTE, ]=HALF NOTE, ↑=#, ↓=b, ↔=NATURAL, 2 SLOTS STILL OPEN
04400	
04500	C  50 &=NON-ITALICS(BDR), 51 @=ITALICS(BDI)
04600	C  48 &&=BDL (LIGHT-FACE)     49 IS STILL FREE ****
04700	C  52 #=RETURN TO PRIMITVE FONT, 53 <=OPEN, 54 >=FILLED. ('=55)
04800	C FRENCH ACCENTS=ACCUTE=64, GRAVE=65, CMFLX=66, UMLT=67, CIDLA=68, 69 =EIGHTH NOTE
04900	C                 <<          >>       $$        %%       ##
05000	33	L=1
05100		RC=0
05200		IF(INP(KN).NE.KSLA)GO TO 333
05300		IF(INP(KN+1).NE.KSLA)GO TO 133
05400	C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
05500	333	KN=KN+1
05600		INP(KN)=KSLA
05700	C  SO TRAILING BLANKS ARE DELETED.
05800	133	LL=1
05900		RZ=0 
06000		ISET=IS
06100		IF(R3.LT.1000)GO TO 233
06200		RZ=1
06300		R3=R3-1000.
06400		RC=R3
06500	C  ADD 1000 TO POSITION (R3+1000) FOR CENTERING AT POS. R3.
06600	233	RA=R3
06650		SET=RA
06675	C IF SET = 0 THEN USE SETLET.
06700	C   RA= ADDS UP TOTAL SPACE NEEDED
06800		RX=0
06900	C  FOR SETLET
07000	C******** DASH
07100	368	KA=INP(L)
07200		IF(KA.NE.'?'.AND.KA.NE.'!')GO TO 117
07300	C /??/ = PUT IN LONG DASH TO DIVIDE SYLLABLES.  BUT MUST BE EDITED LATER!!!!!
07400	C /!!/ = PUT IN SHORT DASH TO DIVIDE SYLLABLES.  BUT MUST BE EDITED LATER!!!!!
07500		IF(INP(L+1).NE.KA)GO TO 117
07600		IA=L
07700		L=L+2
07800	217	IF(INP(L).EQ.'/')GO TO 317
07900		L=L+1
08000		IF(L.LT.KN)GO TO 217
08100	317	ML=L
08200		DO 417 N=IA,KN
08300		ML=ML+1
08400		INP(N)=INP(ML)
08500	C GET RID OF /??  AND SLIDE DATA TO LEFT.
08600	417	INP(ML)=IBLA
08700		KN=KN-(L-IA)-1
08800		L=IA
08900	CC	L=L+1
09000	817	RN(IS)=8.
09100		RN(IS+1)=4.
09200		RN(IS+2)=R2
09300		RN(IS+3)=RA-4.
09400		RN(IS+4)=R4
09500		RN(IS+5)=R4
09600		RN(IS+6)=RA
09700		RN(IS+7)=0
09800		RN(IS+8)=0
09900		RN(IS+9)=0
10000		RN(IS+10)=1.
10100		IF(KA.NE.'!')GO TO 917
10200	C NOW SHORT DASHES
10300		RN(IS+7)=1.
10400		RN(IS+10)=2.
10500	917	IS=IS+11
10600		RZ=0
10700		GO TO 1370
10800	C******** DASH
10900	117	RN(IS+1)=16
11000		RN(IS+3)=RA
11100	C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
11200	CC	Y=39.6*RSTJ3
11300	C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
11400		RN(IS+2)=R2
11500		RN(IS+4)=R4
11600		CALL NOZERO(R5)
11700		RN(IS+5)=R5
11800		IF(R5.GE.100)R5=R5-100
11900	C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP. PARTS.
12000	CKK	KK=0
12100		DO 364 J5=6,8
12200		Z=0
12300	CXX	DO 363 J4=1,4
12400		J4=1
12500	361	IA=INP(L)
12600		IF(IA.NE.KSLA)GO TO 365
12700	C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
12800		IF(INP(L+1).NE.KSLA)GO TO 433
12900	C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
13000	CKK	KK=KK+1
13100		L=L+1
13200		GO TO 365
13300	433	J3=J4
13400		DO 367 KA=J5,8
13500		X=99.
13600		DO 366 K=J3,4
13700		Z=Z+X
13800	366	X=X*100.0
13900		RN(IS+KA)=Z
14000		J3=1
14100	367	Z=0
14200		L=L+1
14300	C  L=CHARACTER COUNTER
14400		GO TO 369
14500	365	DO 362 J=1,30
14600		IF(IA.NE.JALPHA(J))GO TO 362
14700	CC	IF(J.NE.21)GO TO 360
14800	C NOW '?'
14900	CC	IF(INP(L+1).NE.LSQ)GO TO 360
15000	C NOW '?[' = EIGHTH NOTE   N=69
15100	CC	L=L+1
15200	CC	J=34
15300	360	N=35+J
15400	C  FOUND A SPECIAL CHARACTER.
15500		IF(N.EQ.65)N=69
15600	C NOW '}' = EIGHTH NOTE   N=69
15700		K=N
15800		IFNT=0
15900		IF(N.LT.48)GO TO 39
16000		IF(N.GT.54)GO TO 39
16100		IF(IA.NE.INP(L+1))GO TO 39
16200	C NEXT FOR DBL CHARS.
16300		GO TO(1,2,3,39,7,4,5)N-47
16400	C FOR FRENCH ACCENTS
16500	1	N=66
16600	CIRCUMFLEX   TYPE $$
16700		GO TO 6
16800	2	N=67
16900	C UMLAUT   TYPE %%
17000		GO TO 6
17100	3	N=48
17200	C &&=BDL40 FONT
17300		GO TO 6
17400	4	N=64
17500	C ACCUTE  TYPE >>
17600		GO TO 6
17700	7	N=68
17800	C CEDILLA  TYPE ##
17900		GO TO 6
18000	5	N=65
18100	C GRAVE  TYPE <<
18200	CC	IF(N.NE.50)GO TO 39
18300	CC	IF(IA.NE.INP(L+1))GO TO 39
18400	6	K=N
18500		L=L+1
18600	C  TYPE && FOR LIGHT-FACE (BDL).  PUSH PTR (L) ALONG 1 MORE.
18700		GO TO 39
18800	362	CONTINUE
18900	38	N=10-(LA-INP(L))/536870912
19000	C   MAGIC NUMBER TO FIND LETTERS
19100		IF(N.LT.10)N=N+7
19200		K=N
19300		IF(KFNT)IFNT=0
19400		IF(N.LT.40)GO TO 39
19500		N=N+28
19600		KFNT=-1
19700	C  TO INITIALIZE AUTOMATIC LOWER CASE SYSTEM.
19800		K=N-60
19900	C  K IS ACTUAL LETTER NUMB. (a=10, ETC.)
20000		IFNT=-1
20100	C LOWER CASE LETTERS ARE 60 .GT. UPPER. A=10, a=70, b=71, etc.
20200	39	L=L+1
20300	C  BLANK=47  =99 WHEN NO MORE CHARS TO COME.
20400	C*********** NEW 12/79 ****** ALSO CHANGE 363 LOOP******************
20500		IF(N.LT.48.OR.N.GT.52)GO TO 392
20600	C SAVE THE FONT CODE
20700		XFONT=N
20800		GO TO 391
20900	392	IF(J4.NE.1)GO TO 391
21000	C SKIP IF FONT CODE OR NOT 1ST CHAR. OF GROUP
21100		IF(RX.NE.0)GO TO 391
21200		IF(RZ.NE.0)GO TO 391
21300	C PUTS FONT CODE AT FIRST OF EACH CHAR. GROUP.
21400		J4=J4+1
21500		Z=XFONT*1000000.
21600	C*******************************************************
21700	391	IF(N.LT.64.OR.N.GT.68)CALL SPACER(K,IFNT,RX,3.32)
21800	CC  63=SLASH     391	IF(N.LT.63.OR.N.GT.68)CALL SPACER(K,IFNT,RX,3.32)
21900	C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
22000	C  GET SPACE FOR THIS LETTER.  IGNORE ACCENTS (63-68)
22100		X=N
22200		IF(J4.EQ.2)X=X*10000.
22300		IF(J4.EQ.3)X=X*100.
22400		IF(J4.EQ.1)X=X*1000000.
22500	363	Z=Z+X
22600		J4=J4+1
22700		IF(J4.LE.4)GO TO 361
22800	364	RN(IS+J5)=Z
22900	369	RN(IS+9)=RX
23000		RN(IS+10)=RZ
23100		IF(RZ.EQ.0)KNT=KNT+1
23200		IF(RC.NE.0)RN(IS+10)=RC
23300		RC=0
23400	C  FOR CONTINUATION
23500		RA=RA+RX*R5
23600		IF(IA.EQ.KSLA)RA=RA+5
23700	C  SPACES GROUPS DIVIDED BY SLASHES
23800		RX=0
23900	C***	IF(RZ.NE.0)GO TO 370
24000	C  SKIP IF P10=1, REQUIRED FOR CONTINUATION OF TEXT.
24100	C***	IF(IBLANK(IS,7))RZ=-2
24200	C IF LAST CHAR IN P7 IS BLANK RESET WDCNT, GET RID OF P8 AND P9
24300	C***	IF(IBLANK(IS,6))RZ=-3
24400	C ↑↑↑↑ LAST CHAR IN P6=BLNK ZAPS P7 IF NOT NEEDED. RZ=- CHANGES WORDCNT
24500	C***370	RN(IS)=7+RZ
24600	C NOW WILL PUT SIZE INTO P9 ALWAYS.  (FOR CODE 4 DASH CENTERING FEATURE.)
24700	370	IF(RZ.LT.0)RZ=0 
24800	C***370	RN(IS)=7+RZ
24900	       	RN(IS)=7+RZ
25000		IS=IS+10+RZ
25100		RZ=1.
25200		IF(IA.EQ.KSLA)RZ=0
25300	1370	LL=LL+1
25400		PWDS(ITEM+LL)=IS
25500	C  PUT IT IN THE PNTR ARRAY
25600		IF(L.LT.KN)GO TO 368
25700	C   WAS ↑↑↑↑↑↑↑ .LE.    5/22/76
25800	
25900		IX=ITEM+LL-1
26000	C IX IS FOR DASHES
26100		IF(SET.EQ.0)CALL SETLET
26110	C  GOES TO SETLET AUTOMATICALLY IF P3 = 0.
26120	CCC	IF(KNT.GT.0)CALL SETLET
26200	C  GOES TO SETLET AUTOMATICALLY IF MORE THAN ONE SLASH FOUND.
26300		IF(KFNT)IFNT=0
26400		KFNT=0
26500		INP(1)=0
26600	C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
26700		END
26800	C  PACKS 4 CHARS/WD, 3 WDS/ITEM.
26900	
27000	CC	SUBROUTINE NAMEXT(JA,NAME,IEXT)
27100		SUBROUTINE DUMMY
27200		COMMON /MKX/MKX(7),PRNL
27300		DIMENSION JA(1),A(5),FM(7)
27400		DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
27500		EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
27600		1 (FM5,FM(5)),(FM6,FM(6)),(FM7,FM(7)),(A3,A(3))
27700		DO 9 K=2,7
27800	9	FM(K)=' '
27900		ID=0
28000		IA=0
28100		NAME=' '
28200		DO 1 K=20,1,-1
28300		IF(JA(K).EQ.' ')GO TO 1
28400	5	DO 2 L=K-1,1,-1
28500		J=JA(L)
28600		IF(J.NE.' ')GO TO 3
28700		IA=L
28800		GO TO 4
28900	3	IF(J.NE.'.')GO TO 2
29000		ID=L
29100		K=L
29200	C '.' ASSUMES THERE IS AN EXTENSION 
29300		GO TO 5
29400	2	CONTINUE
29500		GO TO 4
29600	1	CONTINUE
29700	C ALL BLANK IF WE GET HERE
29800		RETURN
29900	4	IF(IA.NE.0)GO TO 6
30000		IF(JA(1).EQ.-1)RETURN
30100	C  ↑↑↑ FOR 'RS', 'SA', 'G', ETC. WITH NO NAME FOLLOWING.
30200		IF(ID.NE.0)GO TO 7
30300	C NOW ONLY A NAME IS ON THIS LINE
30400		FM2=A5
30500		FM3=PRNL
30600	C GET LEFT PARENTHESIS
30700		REREAD FM,NAME
30800		GO TO 10
30900	7	FM3=',A1,'
31000		FM2=A(ID-1)
31100		FM4=A3
31200		FM5=PRNL
31300	C  FOUND NAME AND EXTENSION
31400		REREAD FM, NAME,K,IEXT
31500		GO TO 11
31600	6	IF(IA.GT.5)RETURN
31700	C .GT.5 = TOO MUCH IN FRONT OF NAME!!
31800		FM2=A(IA)
31900		FM3=','
32000		IF(ID.NE.0)GO TO 8
32100		FM4=A5
32200		FM5=PRNL
32300	C  FOUND  'WORD', NAME    WORD= SA, RS, GM, ETC.
32400		REREAD FM,K,NAME
32500		GO TO 10
32600	8	FM4=A(ID-IA-1)
32700		FM5=',A1,'
32800		FM6=A3
32900		FM7=PRNL
33000		REREAD FM,K,NAME,K,IEXT
33100	11	CALL LO2UP(IEXT)
33200	10	CALL LO2UP(NAME)
33300		END
33400	
33500		SUBROUTINE TYPOUT
33600		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
33700		1 JX,ISM,IQ,VX(50),IMP,K,KN,M,MD,IBLA /ALF/INP(72) /IDEV/IDEV
33800		IF(IDEV.NE.5)RETURN
33900		DO 1 KK=72,1,-1
34000	1	IF(INP(KK).NE.IBLA)GO TO 2
34100	2	CALL TYPINT(MODE)
34200		CALL TYPCHR('   ',3)
34300		DO 3  KKK=1,KK
34400	3	CALL TYPCHR(INP(KKK),1)
34500		CALL TYPCRLF
34600		END
34700	
34800		SUBROUTINE PACKX(NAM,KNM)
34900		DIMENSION KNM(5)
35000		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
35100		1 , MM/"774000000000/
35200		NAM=0
35300		DO 12 K=5,1,-1
35400		NAM=NAM .OR. (KNM(K) .AND. MM)
35500		IF (K.EQ.1)RETURN
35600	17	IF (NAM.GE.0)GO TO 13
35700		NAM = (( NAM .AND. LL)/KK) .OR. JJ
35800		GO TO 12
35900	13	NAM = NAM / KK
36000	12	CONTINUE
36100		RETURN
36200		END
36300	
36400		SUBROUTINE NAMEXT(I,NAME,IEXT)
36500	C FINDS NAME.EXT IN A1 STRING
36600		DIMENSION I(1)
36700	
36800		IF(I(1).NE.-1)GO TO 9
36900	C FIRST PASS UP 'G', 'GM', 'RS', ETC.  (=-1)
37000		DO 1 K=1,72
37100	1	IF(I(K).EQ.' ')GO TO 2
37200	C NOW PASS BLANKS
37300	2	J=72
37400		DO 3 J=K+1,72
37500	3	IF(I(J).NE.' ')GO TO 4
37600	C NOW FOUND START OF WORD (UNLESS ALL BLANKS)
37700	4	IF(J.NE.72)GO TO 5
37800		NAME=' '
37900		RETURN
38000	9	J=1
38100	5	DO 6 K=J,72
38200		IF(I(K).EQ.' ')GO TO 7
38300	C JUMP IF NAME ONLY
38400	6	IF(I(K).EQ.'.')GO TO 8
38500	7	CALL PACKX(NAME,I(J))
38600		RETURN
38700	8	CALL RLOOP(I(61),I(J),K-J)
38800		CALL PACKX(NAME,I(61))
38900		CALL PACKX(IEXT,I(K+1))
39000		END